home *** CD-ROM | disk | FTP | other *** search
/ Softdisk Supreme / Softdisk Supreme.iso / pc / DSK Files / 0-49 / SD018b.dsk / FOUNDATION.bas < prev    next >
BASIC Source File  |  2003-06-12  |  10KB  |  135 lines
  1. 10  POKE  -16304,0: POKE  -16302,0: POKE  -16299,0: POKE  -16297,0
  2. 20 R =  RND(1): IF  PEEK( -16384) <128  THEN 20
  3. 30  POKE  -16368,0: HOME : POKE 230,32: CALL 62450: POKE  -16301,1: POKE  -16300,0: POKE  -16303,0: PRINT 
  4. 40  DIM D(52),DK(52),V(35),S(35),X(42),Y(42):L = 768:A1 = 8:A2 = 21:A3 = 27:A4 = 84:A5 = 70: SCALE= 1: ROT= 0: POKE 232,0: POKE 233,16:CU = 1
  5. 50  FOR J = 1 TO 52:DK(J) = J: NEXT 
  6. 60  HTAB 14: INVERSE : PRINT " SHUFFLING ": FOR I = 36 TO 42: GOSUB 70: NEXT :I = 0: GOSUB 70: GOTO 220
  7. 70  IF I = 7  OR I = 8  OR I = 21  OR I = 22  OR I = 35  OR I = 36  THEN X(I) = 12: GOTO 140
  8. 80  IF I = 6  OR I = 9  OR I = 20  OR I = 23  OR I = 34  OR I = 37  THEN X(I) = 48: GOTO 140
  9. 90  IF I = 5  OR I = 10  OR I = 19  OR I = 24  OR I = 33  OR I = 38  THEN X(I) = 84: GOTO 140
  10. 100  IF I = 0  OR I = 4  OR I = 11  OR I = 18  OR I = 25  OR I = 32  OR I = 39  THEN X(I) = 120: GOTO 140
  11. 110  IF I = 3  OR I = 12  OR I = 17  OR I = 26  OR I = 31  OR I = 40  THEN X(I) = 156: GOTO 140
  12. 120  IF I = 2  OR I = 13  OR I = 16  OR I = 27  OR I = 30  OR I = 41  THEN X(I) = 192: GOTO 140
  13. 130  IF I = 1  OR I = 14  OR I = 15  OR I = 28  OR I = 29  OR I = 42  THEN X(I) = 228
  14. 140  IF I < = 7  AND I > = 1  THEN Y(I) = 10: GOTO 210
  15. 150  IF I < = 14  AND I > = 8  THEN Y(I) = 25: GOTO 210
  16. 160  IF I < = 21  AND I > = 15  THEN Y(I) = 40: GOTO 210
  17. 170  IF I < = 28  AND I > = 22  THEN Y(I) = 55: GOTO 210
  18. 180  IF I < = 35  AND I > = 29  THEN Y(I) = 70: GOTO 210
  19. 190  IF I < = 42  AND I > = 36  THEN Y(I) = 115: GOTO 210
  20. 200  IF I = 0  THEN Y(I) = 123
  21. 210  RETURN 
  22. 220  POKE 33,39: PRINT : PRINT : FOR C = 52 TO 1  STEP  -1
  23. 230 R =  INT( RND(1) *104 +1): IF R >52  THEN 230
  24. 240  IF DK(R) = 0  THEN 230
  25. 250 DK(R) = 0:D(C) = R: INVERSE : POKE 783,75: CALL L: PRINT "*";: NORMAL : PRINT "  ";: IF C = 14  OR C = 27  OR C = 40  THEN  PRINT 
  26. 260  NEXT : FOR P = 1 TO 500: NEXT : HOME : POKE 33,40
  27. 270  POKE 34,20: HOME : HGR : HCOLOR= 6: HPLOT 0,0 TO 0,159 TO 268,159 TO 268,0 TO 2,0 TO 2,158 TO 266,158 TO 266,1 TO 2,1: FOR C = 1 TO 35:V(C) = D(C):D(C) = 0
  28. 280 S(C) = 14
  29. 290  IF V(C) >13  THEN S(C) = S(C) +1:V(C) = V(C) -13: GOTO 290
  30. 300 I = C: GOSUB 70: REM FIND LOCATIONS FOR CARDS DEALT OUT
  31. 310  GOSUB 5000: NEXT : GOSUB 7000
  32. 320 C = 0: IF D(52) = 0  THEN 400: REM DEAL A CARD
  33. 330 C = C +1:C1 = 52 -C: IF D(C) = 0  THEN 330
  34. 340 I = 0:S(I) = 14
  35. 350 V(I) = D(C):D(C) = 0
  36. 360  IF V(I) >13  THEN V(I) = V(I) -13:S(I) = S(I) +1: GOTO 360
  37. 370  GOSUB 5000
  38. 400  HTAB 1: VTAB 21: PRINT "[<--------- MOVE POINTER ----------->]  [F] PLAY THE CARD TO THE FOUNDATION     [T] TAKE CARD FROM DECK   [ESC] = QUIT  THE DECK HAS ";: INVERSE : PRINT C1;: NORMAL : PRINT " CARDS LEFT ";
  39. 410  POKE  -16368,0
  40. 420 R =  RND(1):R =  FRE(0): IF  PEEK( -16384) <128  THEN 420
  41. 430  GET A$:A =  ASC(A$): IF A < >A1  AND A < >A2  AND A < >A3  AND A < >A4  AND A < >A5  THEN  HOME : PRINT : PRINT "<CTRL-G>        YOU GOOFED - TRY AGAIN<CTRL-G>": FOR P = 1 TO 2000: NEXT : GOTO 400
  42. 440  IF A = A4  THEN  HTAB 1: GOTO 320
  43. 450  IF A = A3  THEN  HOME : GOTO 6000: REM QUIT ROUTINE
  44. 460  IF A = A1  AND CU < >1  THEN OC = CU:CU = CU -1: GOSUB 7500: GOSUB 7000: GOTO 400
  45. 470  IF A = A2  AND CU < >7  THEN OC = CU:CU = CU +1: GOSUB 7500: GOSUB 7000: GOTO 400
  46. 480  IF A = A1  AND CU = 1  THEN OC = CU:CU = CU +6: GOSUB 7500: GOSUB 7000: GOTO 400
  47. 490  IF A = A2  AND CU = 7  THEN OC = CU:CU = CU -6: GOSUB 7500: GOSUB 7000: GOTO 400
  48. 500  ON CU GOTO 510,1500,2000,2500,3000,3500,4000
  49. 510  IF V(7) = 0  THEN  HOME : PRINT "<CTRL-G>THERE ARE NO CARDS HERE<CTRL-G>!": FOR P = 1 TO 3000: NEXT : GOTO 400
  50. 520  IF V(35) < >0  THEN I = 35:II = 22: GOTO 600
  51. 530  IF V(22) < >0  THEN I = 22:II = 21: GOTO 600
  52. 540  IF V(21) < >0  THEN I = 21:II = 8: GOTO 600
  53. 550  IF V(8) < >0  THEN I = 8:II = 7: GOTO 600
  54. 560 I = 7
  55. 570  IF (V(I) = V(0) +1)  OR (V(I) = V(0) -1)  THEN  HCOLOR= 4: DRAW 18 AT X(I),Y(I):V(0) = V(I):V(I) = 0:S(0) = S(I):S(I) = 0:I = 0: GOSUB 5000: GOTO 9000
  56. 580  GOTO 8000
  57. 600  IF (V(I) = V(0) +1)  OR (V(I) = V(0) -1)  THEN  HCOLOR= 4: DRAW 18 AT X(I),Y(I): HCOLOR= 7: DRAW S(II) +5 AT X(I),Y(I):V(0) = V(I):V(I) = 0:S(0) = S(I):S(I) = 0:I = 0: GOSUB 5000: GOTO 9000
  58. 610  GOTO 8000
  59. 1500  IF V(6) = 0  THEN  HOME : PRINT : PRINT "<CTRL-G>THERE ARE NO CARDS HERE!<CTRL-G>": FOR P = 1 TO 3000: NEXT : GOTO 400
  60. 1510  IF V(34) < >0  THEN I = 34:II = 23: GOTO 600
  61. 1520  IF V(23) < >0  THEN I = 23:II = 20: GOTO 600
  62. 1530  IF V(20) < >0  THEN I = 20:II = 9: GOTO 600
  63. 1540  IF V(9) < >0  THEN I = 9:II = 6: GOTO 600
  64. 1550 I = 6: GOTO 570
  65. 2000  IF V(5) = 0  THEN  HOME : PRINT : PRINT "<CTRL-G>THERE ARE NO CARDS HERE!<CTRL-G>": FOR P = 1 TO 3000: NEXT : GOTO 400
  66. 2010  IF V(33) < >0  THEN I = 33:II = 24: GOTO 600
  67. 2020  IF V(24) < >0  THEN I = 24:II = 19: GOTO 600
  68. 2030  IF V(19) < >0  THEN I = 19:II = 10: GOTO 600
  69. 2040  IF V(10) < >0  THEN I = 10:II = 5: GOTO 600
  70. 2050 I = 5: GOTO 570
  71. 2500  IF V(4) = 0  THEN  HOME : PRINT : PRINT "<CTRL-G>THERE ARE NO CARDS HERE!<CTRL-G>": FOR P = 1 TO 3000: NEXT : GOTO 400
  72. 2510  IF V(32) < >0  THEN I = 32:II = 25: GOTO 600
  73. 2520  IF V(25) < >0  THEN I = 25:II = 18: GOTO 600
  74. 2530  IF V(18) < >0  THEN I = 18:II = 11: GOTO 600
  75. 2540  IF V(11) < >0  THEN I = 11:II = 4: GOTO 600
  76. 2550 I = 4: GOTO 570
  77. 3000  IF V(3) = 0  THEN  HOME : PRINT : PRINT "<CTRL-G>THERE ARE NO CARDS HERE!<CTRL-G>": FOR P = 1 TO 3000: NEXT : GOTO 400
  78. 3010  IF V(31) < >0  THEN I = 31:II = 26: GOTO 600
  79. 3020  IF V(26) < >0  THEN I = 26:II = 17: GOTO 600
  80. 3030  IF V(17) < >0  THEN I = 17:II = 12: GOTO 600
  81. 3040  IF V(12) < >0  THEN I = 12:II = 3: GOTO 600
  82. 3050 I = 3: GOTO 570
  83. 3500  IF V(2) = 0  THEN  HOME : PRINT : PRINT "<CTRL-G>THERE ARE NO CARDS HERE!<CTRL-G>": FOR P = 1 TO 3000: NEXT : GOTO 400
  84. 3510  IF V(30) < >0  THEN I = 30:II = 27: GOTO 600
  85. 3520  IF V(27) < >0  THEN I = 27:II = 16: GOTO 600
  86. 3530  IF V(16) < >0  THEN I = 16:II = 13: GOTO 600
  87. 3540  IF V(13) < >0  THEN I = 13:II = 2: GOTO 600
  88. 3550 I = 2: GOTO 570
  89. 4000  IF V(1) = 0  THEN  HOME : PRINT : PRINT "<CTRL-G>THERE ARE NO CARDS HERE!<CTRL-G>": FOR P = 1 TO 3000: NEXT : GOTO 400
  90. 4010  IF V(29) < >0  THEN I = 29:II = 28: GOTO 600
  91. 4020  IF V(28) < >0  THEN I = 28:II = 15: GOTO 600
  92. 4030  IF V(15) < >0  THEN I = 15:II = 14: GOTO 600
  93. 4040  IF V(14) < >0  THEN I = 14:II = 1: GOTO 600
  94. 4050 I = 1: GOTO 570
  95. 4999  END 
  96. 5000  POKE 783,100: HCOLOR= 7: DRAW 18 AT X(I),Y(I): HCOLOR= 4: DRAW V(I) AT X(I) +5,Y(I) +5: CALL L
  97. 5010  IF S(I) = 14  OR S(I) = 15  THEN  HCOLOR= 4
  98. 5020  IF S(I) = 16  OR S(I) = 17  THEN  HCOLOR= 5
  99. 5030  DRAW S(I) AT X(I) +12,Y(I) +25: RETURN 
  100. 6000  VTAB 22: PRINT "DO YOU WANT TO END THIS HAND?";: GET A$: PRINT A$: IF A$ < >"Y"  AND A$ < >"N"  THEN 6000
  101. 6010  IF A$ = "N"  THEN 400
  102. 6020  HOME : VTAB 24: PRINT "DO YOU WANT ME TO DEAL AGAIN?";: GET A$: IF A$ < >"Y"  AND A$ < >"N"  THEN 6020
  103. 6030  IF A$ = "Y"  THEN  POKE 34,5: RUN 
  104. 6040  HOME : VTAB 21: PRINT "[ESC] TO BASIC                          ANY OTHER KEY = PR#6";: GET A$: HOME : PRINT :A =  ASC(A$): IF A < >27  THEN  HOME : TEXT : POKE 230,64: CALL 62450: POKE 230,32: CALL 62450: PRINT  CHR$(4);"PR#6": END 
  105. 6050  HOME : TEXT : POKE 104,8: POKE 230,64: CALL 62450: POKE 230,32: CALL 62450: PRINT  CHR$(4);"FP": END 
  106. 7000 I = CU +35: HCOLOR= 7: DRAW 53 AT X(I) +12,Y(I): RETURN 
  107. 7500 I = OC +35: HCOLOR= 4: DRAW 53 AT X(I) +12,Y(I): RETURN 
  108. 8000  HOME : PRINT : PRINT "<CTRL-G>YOU CAN'T PUT A";
  109. 8010  IF V(I) = 1  THEN  PRINT "N ACE ON A";
  110. 8020  IF V(I) = 8  THEN  PRINT "N EIGHT ON A";
  111. 8030  IF V(I) = 11  THEN  PRINT " JACK ON A";
  112. 8040  IF V(I) = 12  THEN  PRINT " QUEEN ON A";
  113. 8050  IF V(I) = 13  THEN  PRINT " KING ON A";
  114. 8060  IF (V(I) >1  AND V(I) <8)  OR V(I) = 9  OR V(I) = 10  THEN  PRINT " ";V(I);" ON A";
  115. 8070  IF V(0) = 1  THEN  PRINT "N ACE!<CTRL-G>"
  116. 8080  IF V(0) = 8  THEN  PRINT "N EIGHT!<CTRL-G>"
  117. 8090  IF V(0) = 11  THEN  PRINT " JACK!<CTRL-G>"
  118. 8100  IF V(0) = 12  THEN  PRINT " QUEEN!<CTRL-G>"
  119. 8110  IF V(0) = 13  THEN  PRINT " KING!<CTRL-G>"
  120. 8120  IF (V(0) >1  AND V(0) <8)  OR V(0) = 9  OR V(0) = 10  THEN  PRINT " ";V(0);"!<CTRL-G>"
  121. 8130  FOR P = 1 TO 3000: NEXT : GOTO 400
  122. 9000 K = 0: FOR I = 1 TO 7:K = K +V(I): NEXT : IF K < >0  THEN  GOTO 400
  123. 9010  HGR : HCOLOR= 6: HPLOT 0,0: CALL 62454: POKE 34,0: HOME :X = 4: FOR Y = 154 TO 4  STEP  -5: HCOLOR=  INT( RND(1) *5 +1): HPLOT 139,154 TO X,Y: POKE 783,( INT( RND(1) *100 +50)): CALL 768: NEXT 
  124. 9020 X = 274: FOR Y = 154 TO 4  STEP  -5: HCOLOR=  INT( RND(1) *5 +1): HPLOT 139,154 TO X,Y: POKE 783,( INT( RND(1) *100 +50)): CALL 768: NEXT 
  125. 9030 X = 139:Y = 4: FOR Z = 0 TO 130  STEP 5: HCOLOR=  INT( RND(1) *5 +1): HPLOT 139,154 TO X +Z,Y: POKE 783,( INT( RND(1) *100 +50)): CALL 768
  126. 9040  HCOLOR=  INT( RND(1) *5 +1): HPLOT 139,154 TO X -Z,Y: POKE 783,( INT( RND(1) *100 +50)): CALL 768: NEXT : GOSUB 10000: REM POKE IN APPLE FLASH
  127. 9050 Y =  -16336:Z =  INT( RND(1) *4 +4): FOR I = 1 TO Z: CALL 771: GOSUB 9100: CALL 768: GOSUB 9100: CALL 774: GOSUB 9100: CALL 768: GOSUB 9100: NEXT : HOME : POKE  -16303,0: VTAB 12: HTAB 14: FLASH : PRINT "<CTRL-G> * YOU WIN * <CTRL-G>": NORMAL : FOR I = 1 TO 3000: NEXT 
  128. 9060  VTAB 20: PRINT "WOULD YOU LIKE TO PLAY AGAIN?";: GET A$: PRINT A$: IF A$ < >"N"  AND A$ < >"Y"  THEN 9060
  129. 9070  IF A$ = "Y"  THEN  PRINT  CHR$(4);"RUN ONE FOUNDATION": END 
  130. 9080  GOTO 6040
  131. 9100  FOR J = 1 TO 10:K =  PEEK(Y) + PEEK(Y): NEXT : RETURN 
  132. 10000  FOR I = 768 TO 880: READ J: POKE I,J: NEXT : RETURN 
  133. 10010  DATA   76,56,3,76,64,3,76,77,3,32,74,255,169,32,141,113,3,141,34,3,160,0,200,192,33,240,28,162,0,32,85,3,157,0,32,232,224,0,240,3,76,29,3,238,113,3,238,34,3,76,22,3,32 
  134. 10020  DATA   63,255,96,169,85,141,30,3,76,9,3,169,96,141,109,3,169,98,141,30,3,76,9,3,169,32,141,109,3,76,69,3,173,113,3,141,93,3,189,0,32,24,105,128,96,173,113,3,141,106,3,189,0,32,73,255,96,94,3,96 
  135. 65432  REM  ** ONE FOUNDATION **       - BY PAUL M. ZELMAN -      [ ALL RIGHTS RESERVED ]